unit uSchematic ;

interface

uses
    Classes,
    Types,
    Menus,
    Graphics,
    Controls,
    ActnList,
    SpTBXTabs,
    uBasic,
    uObjects,
    VirtualTrees,
    Dialogs,
    TntDialogs,
    GDIPOBJ,
    GDIPAPI,
    uVisitor
    ;

type
    TdmSchematic = class( TDataModule )
        ActionList : TActionList ;
        actAddPage : TAction ;
        actDeletePage : TAction ;
        actZoomIn : TAction ;
        actZoomOut : TAction ;
        actRatsNest : TAction ;
        procedure actAddPageExecute( Sender : TObject ) ;
        procedure actAddPageUpdate( Sender : TObject ) ;
        procedure actZoomOutExecute( Sender : TObject ) ;
        procedure actZoomOutUpdate( Sender : TObject ) ;
        procedure actZoomInExecute( Sender : TObject ) ;
        procedure actZoomInUpdate( Sender : TObject ) ;
        procedure actDeletePageExecute( Sender : TObject ) ;
        procedure actDeletePageUpdate( Sender : TObject ) ;
        procedure actRatsNestExecute( Sender : TObject ) ;
        procedure ActionListUpdate( Action : TBasicAction ; var Handled : Boolean ) ;
        procedure DataModuleCreate( Sender : TObject ) ;
        procedure DataModuleDestroy( Sender : TObject ) ;
    private
        { Private declarations }
        fVST : TVirtualStringTree ;
        fSelectedObject : TMedaObject ;
        fPopupVisitor : TPopupVisitor ;
        fNeedsUpdate : boolean ;

        procedure GetNodeDataSize( Sender : TBaseVirtualTree ;
            var NodeDataSize : Integer ) ;
        procedure GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Column : TColumnIndex ; TextType : TVSTTextType ;
            var CellText : WideString ) ;
        procedure NewText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Column : TColumnIndex ; NewText : WideString ) ;
        procedure Editing( Sender : TBaseVirtualTree ; Node : PVirtualNode ; Column : TColumnIndex ; var Allowed : Boolean ) ;
        procedure GetImageIndex( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Kind : TVTImageKind ; Column : TColumnIndex ; var Ghosted : Boolean ; var ImageIndex : Integer ) ;
        procedure InitChildren( Sender : TBaseVirtualTree ; Node : PVirtualNode ; var ChildCount : Cardinal ) ;
        procedure InitNode( Sender : TBaseVirtualTree ; ParentNode,
            Node : PVirtualNode ; var InitialStates : TVirtualNodeInitStates ) ;
        procedure Checked( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
        procedure BeforeCellPaint( Sender : TBaseVirtualTree ;
            TargetCanvas : TCanvas ; Node : PVirtualNode ; Column : TColumnIndex ;
            CellRect : TRect ) ;
        procedure GetBackColor( Node : PVirtualNode ; var ItemColor : TGPColor ) ;
        procedure GetPopupMenu( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Column : TColumnIndex ; const P : TPoint ; var AskParent : Boolean ;
            var PopupMenu : TPopupMenu ) ;
        procedure FreeNode( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
        procedure vstCollapsed( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
        procedure vstExpanded( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
        procedure GetHint( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Column : TColumnIndex ; TextType : TVSTTextType ;
            var CellText : WideString ) ;
    public
        { Public declarations }
        procedure Update ;

        procedure RegisterVST( const Value : TVirtualStringTree ) ;
        procedure UnregisterVST ;
    end ;

var
    dmSchematic     : TdmSchematic ;

implementation

{$R *.dfm}

uses
    uViewSchematic,
    uMain,
    SysUtils ;

procedure TdmSchematic.actZoomInExecute( Sender : TObject ) ;
begin
    vsbSchematicViewer.ZoomIn ;
end ;

procedure TdmSchematic.actZoomOutExecute( Sender : TObject ) ;
begin
    vsbSchematicViewer.ZoomOut ;
end ;

procedure TdmSchematic.actZoomInUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := vsbSchematicViewer.CanZoomIn ;
end ;

procedure TdmSchematic.actZoomOutUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := vsbSchematicViewer.CanZoomOut ;
end ;

procedure TdmSchematic.actAddPageExecute( Sender : TObject ) ;
begin
    vsbSchematicViewer.AddPage( 'a4', True ) ;
end ;

procedure TdmSchematic.actAddPageUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := vsbSchematicViewer.Showing ;
end ;

procedure TdmSchematic.actDeletePageExecute( Sender : TObject ) ;
var
    iComp           : TComponent ;
    iObject         : TObject ;
begin
    iObject := nil ;
    iComp := ( Sender as TAction ).ActionComponent ;
    if assigned( iComp ) and ( iComp is TPopupMenu ) then
        iObject := TObject( TPopupMenu( iComp ).Tag ) ;
    if assigned( iObject ) and ( iObject is TMedaSchematicPage ) then
        TMedaSchematicPage( iObject ).Vaporize ;
end ;

procedure TdmSchematic.actDeletePageUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := vsbSchematicViewer.Showing and vsbSchematicViewer.CanPlace ;
end ;

procedure TdmSchematic.actRatsNestExecute( Sender : TObject ) ;
begin
    vsbSchematicViewer.ShowRatsNest := ( Sender as TAction ).Checked ;
end ;

procedure TdmSchematic.BeforeCellPaint( Sender : TBaseVirtualTree ;
    TargetCanvas : TCanvas ; Node : PVirtualNode ; Column : TColumnIndex ;
    CellRect : TRect ) ;
var
    BackColor       : TGPColor ;
    Ind             : Integer ;
    Rtl             : Boolean ;
    iGraphics       : TGPGraphics ;
    iBrush          : TGPSolidBrush ;
begin
    iGraphics := TGPGraphics.Create( TargetCanvas.Handle ) ;
    iBrush := TGPSolidBrush.Create( aclBackSch ) ;
    try
        BackColor := clWhite ;
        with Sender as TVirtualStringTree do
            if LineMode = lmBands then begin
                if Column = Header.MainColumn then begin
                    Ind := GetNodeLevel( Node ) * Indent ;
                    Rtl := ( Column >= 0 ) and ( Header.Columns[ Column ].BiDiMode = bdRightToLeft )
                        or ( Column < 0 ) and ( BiDiMode = bdRightToLeft ) ;
                    if Rtl then begin
                        Dec( CellRect.Right, Ind ) ;
                        Ind := Integer( Indent ) ;
                    end
                    else begin
                        Inc( CellRect.Left, Ind ) ;
                        Ind := -Integer( Indent ) ;
                    end ;
                end
                else begin
                    Ind := 0 ;
                    Rtl := False ;
                end ;

                GetBackColor( Node, BackColor ) ;
                if BackColor <> Color then begin  // fill cell
                    iBrush.SetColor( BackColor ) ;
                    iGraphics.FillRectangle( iBrush, MakeRect( CellRect ) ) ;
                end ;

                if Column = Header.MainColumn then begin
                    if Rtl then
                        CellRect.Left := CellRect.Right - Integer( Indent )
                    else
                        CellRect.Right := CellRect.Left + Integer( Indent ) ;
                    Inc( CellRect.Bottom ) ;

                    repeat
                        if BackColor <> Color then begin // fill vertical band
                            iBrush.SetColor( BackColor ) ;
                            iGraphics.FillRectangle( iBrush, MakeRect( CellRect ) ) ;
                        end ;

                        Node := Node.Parent ;
                        if not Assigned( Node ) or ( Node = RootNode ) then
                            Break ;

                        Inc( CellRect.Left, Ind ) ;
                        Inc( CellRect.Right, Ind ) ;
                        GetBackColor( Node, BackColor ) ;
                    until False ;
                end ;
            end ;
    finally
        iGraphics.Free ;
        iBrush.Free ;
    end ;
    inherited ;
end ;

procedure TdmSchematic.Checked( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            Data^.aObject.SetSelection( csCheckedNormal = Node.CheckState ) ;
    end ;
end ;

procedure TdmSchematic.Editing( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; Column : TColumnIndex ; var Allowed : Boolean ) ;
var
    Data            : PTreeData ;
begin
    Allowed := False ;
    if assigned( Node ) then try
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            Allowed := Data^.aObject.CanEdit( Column ) ;
    except
    end ;
end ;

procedure TdmSchematic.FreeNode( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then try
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            Data^.aObject.RemoveNode( Sender, Node ) ;
    except
    end ;
end ;

procedure TdmSchematic.GetBackColor( Node : PVirtualNode ; var ItemColor : TGPColor ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then try
        Data := fVST.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            with Data^.aObject do
                ItemColor := GetColor ;
    except
    end ;
end ;

procedure TdmSchematic.GetHint( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; Column : TColumnIndex ; TextType : TVSTTextType ;
    var CellText : WideString ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            CellText := IntToHex( Data^.aObject.UniqueID, 8 ) ;
    end ;
end ;

procedure TdmSchematic.GetImageIndex( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; Kind : TVTImageKind ; Column : TColumnIndex ;
    var Ghosted : Boolean ; var ImageIndex : Integer ) ;
var
    Data            : PTreeData ;
begin
    if ( Column = 0 ) and assigned( Node ) then try
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            ImageIndex := Ord( Data^.aObject.GetIcon ) ;
    except
    end ;
    Ghosted := False ;
end ;

procedure TdmSchematic.GetNodeDataSize( Sender : TBaseVirtualTree ; var NodeDataSize : Integer ) ;
begin
    NodeDataSize := SizeOf( TTreeData ) ;
end ;

procedure TdmSchematic.GetPopupMenu( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; Column : TColumnIndex ; const P : TPoint ;
    var AskParent : Boolean ; var PopupMenu : TPopupMenu ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then try
        Data := fVST.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) and ( Data^.aObject is TMedaViewable ) then begin
            fSelectedObject := TMedaObject( Data^.aObject ) ;
            PopupMenu := TPopupMenu( fSelectedObject.Accept( fPopupVisitor ) ) ;
            PopupMenu.Tag := integer( fSelectedObject ) ;
            AskParent := not assigned( PopupMenu ) ;
        end ;
    except
    end ;
end ;

procedure TdmSchematic.GetText( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; Column : TColumnIndex ; TextType : TVSTTextType ;
    var CellText : WideString ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then try
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            CellText := Data^.aObject.GetText( Column ) ;
    except
    end ;
end ;

procedure TdmSchematic.InitChildren( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; var ChildCount : Cardinal ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then try
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            ChildCount := Data^.aObject.GetChildCount ;
    except
    end ;
end ;

procedure TdmSchematic.InitNode( Sender : TBaseVirtualTree ; ParentNode,
    Node : PVirtualNode ; var InitialStates : TVirtualNodeInitStates ) ;
var
    ParentData, Data : PTreeData ;
begin
    ParentData := Sender.GetNodeData( ParentNode ) ;
    Data := Sender.GetNodeData( Node ) ;

    Data^.aObject := nil ;
    if not assigned( ParentData ) then
        Data^.aObject := vsbSchematicViewer.ProjectView
    else
        Data^.aObject := ParentData^.aObject.GetChild( Node.Index ) ;

    if assigned( Data^.aObject ) then begin
        Data^.aObject.AddNode( Sender, Node ) ;
        if Data^.aObject.HasCheckBox then begin
            if Data^.aObject is TMedaAbstractPlace then
                Node.CheckType := ctRadioButton
            else
                Node.CheckType := ctTriStateCheckBox ;
        end ;
        if Data^.aObject.GetSelection then
            Node.CheckState := csCheckedNormal ;
        if Data^.aObject.GetChildCount > 0 then
            Include( InitialStates, ivsHasChildren ) ;
        if Data^.aObject.Expanded then
            Include( InitialStates, ivsExpanded ) ;
    end ;
end ;

procedure TdmSchematic.NewText( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; Column : TColumnIndex ; NewText : WideString ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then try
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            Data^.aObject.SetName( NewText ) ;
    except
    end ;
end ;

procedure TdmSchematic.vstCollapsed( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            Data^.aObject.Expanded := False ;
    end ;
end ;

procedure TdmSchematic.vstExpanded( Sender : TBaseVirtualTree ; Node : PVirtualNode ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then
            Data^.aObject.Expanded := True ;
    end ;
end ;

procedure TdmSchematic.RegisterVST( const Value : TVirtualStringTree ) ;
begin
    fVST := Value ;
    if assigned( fVST ) then begin
        with fVST do begin
            OnChecked := Checked ;
            OnInitNode := InitNode ;
            OnInitChildren := InitChildren ;
            OnFreeNode := FreeNode ;
            OnGetNodeDataSize := GetNodeDataSize ;
            OnGetText := GetText ;
            OnGetImageIndex := GetImageIndex ;
            OnEditing := Editing ;
            OnNewText := NewText ;
            OnBeforeCellPaint := BeforeCellPaint ;
            OnGetPopupMenu := GetPopupMenu ;
            OnCollapsed := vstCollapsed ;
            OnExpanded := vstExpanded ;
        end ;
    end ;
end ;

procedure TdmSchematic.UnregisterVST ;
begin
    if assigned( fVST ) then begin
        with fVST do begin
            Clear ;
            OnChecked := nil ;
            OnInitNode := nil ;
            OnInitChildren := nil ;
            OnFreeNode := nil ;
            OnGetNodeDataSize := nil ;
            OnGetText := nil ;
            OnGetImageIndex := nil ;
            OnEditing := nil ;
            OnNewText := nil ;
            OnBeforeCellPaint := nil ;
            OnGetPopupMenu := nil ;
            OnCollapsed := nil ;
            OnExpanded := nil ;
            OnGetHint := nil ;
        end ;
    end ;
    fVST := nil ;
end ;

procedure TdmSchematic.ActionListUpdate( Action : TBasicAction ;
    var Handled : Boolean ) ;
begin
    if fNeedsUpdate then try
        if assigned( fVST ) then
            with fVST do begin
                BeginUpdate ;
                try
                    Clear ;
                    NodeDataSize := SizeOf( TTreeData ) ;
                    if assigned( vsbSchematicViewer.ProjectView ) then
                        RootNodeCount := 1 ;
                finally
                    EndUpdate ;
                end ;
            end ;
    finally
        Handled := True ;
        fNeedsUpdate := False ;
    end ;
end ;

procedure TdmSchematic.Update ;
begin
    fNeedsUpdate := True ;
end ;

procedure TdmSchematic.DataModuleCreate( Sender : TObject ) ;
begin
    fPopupVisitor := TPopupVisitor.Create ;
end ;

procedure TdmSchematic.DataModuleDestroy( Sender : TObject ) ;
begin
    fPopupVisitor.Free ;
end ;

initialization
    dmSchematic := TdmSchematic.Create( nil ) ;

finalization
    dmSchematic.Free ;

end.

